home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_perl.idb / usr / freeware / lib / perl5 / 5.00502 / Getopt / Long.pm.z / Long.pm
Encoding:
Perl POD Document  |  1998-10-28  |  39.4 KB  |  1,382 lines
  1. # GetOpt::Long.pm -- Universal options parsing
  2.  
  3. package Getopt::Long;
  4.  
  5. # RCS Status      : $Id: GetoptLong.pl,v 2.18 1998-06-14 15:02:19+02 jv Exp $
  6. # Author          : Johan Vromans
  7. # Created On      : Tue Sep 11 15:00:12 1990
  8. # Last Modified By: Johan Vromans
  9. # Last Modified On: Sun Jun 14 13:17:22 1998
  10. # Update Count    : 705
  11. # Status          : Released
  12.  
  13. ################ Copyright ################
  14.  
  15. # This program is Copyright 1990,1998 by Johan Vromans.
  16. # This program is free software; you can redistribute it and/or
  17. # modify it under the terms of the GNU General Public License
  18. # as published by the Free Software Foundation; either version 2
  19. # of the License, or (at your option) any later version.
  20. # 
  21. # This program is distributed in the hope that it will be useful,
  22. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24. # GNU General Public License for more details.
  25. # 
  26. # If you do not have a copy of the GNU General Public License write to
  27. # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
  28. # MA 02139, USA.
  29.  
  30. ################ Module Preamble ################
  31.  
  32. use strict;
  33.  
  34. BEGIN {
  35.     require 5.004;
  36.     use Exporter ();
  37.     use vars     qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  38.     $VERSION     = "2.17";
  39.  
  40.     @ISA         = qw(Exporter);
  41.     @EXPORT      = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
  42.     %EXPORT_TAGS = qw();
  43.     @EXPORT_OK   = qw();
  44.     use AutoLoader qw(AUTOLOAD);
  45. }
  46.  
  47. # User visible variables.
  48. use vars @EXPORT, @EXPORT_OK;
  49. use vars qw($error $debug $major_version $minor_version);
  50. # Deprecated visible variables.
  51. use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
  52.         $passthrough);
  53. # Official invisible variables.
  54. use vars qw($genprefix);
  55.  
  56. # Public subroutines. 
  57. sub Configure (@);
  58. sub config (@);            # deprecated name
  59. sub GetOptions;
  60.  
  61. # Private subroutines. 
  62. sub ConfigDefaults ();
  63. sub FindOption ($$$$$$$);
  64. sub Croak (@);            # demand loading the real Croak
  65.  
  66. ################ Local Variables ################
  67.  
  68. ################ Resident subroutines ################
  69.  
  70. sub ConfigDefaults () {
  71.     # Handle POSIX compliancy.
  72.     if ( defined $ENV{"POSIXLY_CORRECT"} ) {
  73.     $genprefix = "(--|-)";
  74.     $autoabbrev = 0;        # no automatic abbrev of options
  75.     $bundling = 0;            # no bundling of single letter switches
  76.     $getopt_compat = 0;        # disallow '+' to start options
  77.     $order = $REQUIRE_ORDER;
  78.     }
  79.     else {
  80.     $genprefix = "(--|-|\\+)";
  81.     $autoabbrev = 1;        # automatic abbrev of options
  82.     $bundling = 0;            # bundling off by default
  83.     $getopt_compat = 1;        # allow '+' to start options
  84.     $order = $PERMUTE;
  85.     }
  86.     # Other configurable settings.
  87.     $debug = 0;            # for debugging
  88.     $error = 0;            # error tally
  89.     $ignorecase = 1;        # ignore case when matching options
  90.     $passthrough = 0;        # leave unrecognized options alone
  91. }
  92.  
  93. ################ Initialization ################
  94.  
  95. # Values for $order. See GNU getopt.c for details.
  96. ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
  97. # Version major/minor numbers.
  98. ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
  99.  
  100. # Set defaults.
  101. ConfigDefaults ();
  102.  
  103. ################ Package return ################
  104.  
  105. 1;
  106.  
  107. __END__
  108.  
  109. ################ AutoLoading subroutines ################
  110.  
  111. # RCS Status      : $Id: GetoptLongAl.pl,v 2.20 1998-06-14 15:02:19+02 jv Exp $
  112. # Author          : Johan Vromans
  113. # Created On      : Fri Mar 27 11:50:30 1998
  114. # Last Modified By: Johan Vromans
  115. # Last Modified On: Sun Jun 14 13:54:35 1998
  116. # Update Count    : 24
  117. # Status          : Released
  118.  
  119. sub GetOptions {
  120.  
  121.     my @optionlist = @_;    # local copy of the option descriptions
  122.     my $argend = '--';        # option list terminator
  123.     my %opctl = ();        # table of arg.specs (long and abbrevs)
  124.     my %bopctl = ();        # table of arg.specs (bundles)
  125.     my $pkg = (caller)[0];    # current context
  126.                 # Needed if linkage is omitted.
  127.     my %aliases= ();        # alias table
  128.     my @ret = ();        # accum for non-options
  129.     my %linkage;        # linkage
  130.     my $userlinkage;        # user supplied HASH
  131.     my $opt;            # current option
  132.     my $genprefix = $genprefix;    # so we can call the same module many times
  133.     my @opctl;            # the possible long option names
  134.  
  135.     $error = '';
  136.  
  137.     print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
  138.           "called from package \"$pkg\".",
  139.           "\n  ",
  140.           'GetOptionsAl $Revision: 2.20 $ ',
  141.           "\n  ",
  142.           "ARGV: (@ARGV)",
  143.           "\n  ",
  144.           "autoabbrev=$autoabbrev,".
  145.           "bundling=$bundling,",
  146.           "getopt_compat=$getopt_compat,",
  147.           "order=$order,",
  148.           "\n  ",
  149.           "ignorecase=$ignorecase,",
  150.           "passthrough=$passthrough,",
  151.           "genprefix=\"$genprefix\".",
  152.           "\n")
  153.     if $debug;
  154.  
  155.     # Check for ref HASH as first argument. 
  156.     # First argument may be an object. It's OK to use this as long
  157.     # as it is really a hash underneath. 
  158.     $userlinkage = undef;
  159.     if ( ref($optionlist[0]) and
  160.      "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
  161.     $userlinkage = shift (@optionlist);
  162.     print STDERR ("=> user linkage: $userlinkage\n") if $debug;
  163.     }
  164.  
  165.     # See if the first element of the optionlist contains option
  166.     # starter characters.
  167.     if ( $optionlist[0] =~ /^\W+$/ ) {
  168.     $genprefix = shift (@optionlist);
  169.     # Turn into regexp. Needs to be parenthesized!
  170.     $genprefix =~ s/(\W)/\\$1/g;
  171.     $genprefix = "([" . $genprefix . "])";
  172.     }
  173.  
  174.     # Verify correctness of optionlist.
  175.     %opctl = ();
  176.     %bopctl = ();
  177.     while ( @optionlist > 0 ) {
  178.     my $opt = shift (@optionlist);
  179.  
  180.     # Strip leading prefix so people can specify "--foo=i" if they like.
  181.     $opt = $+ if $opt =~ /^$genprefix+(.*)$/s;
  182.  
  183.     if ( $opt eq '<>' ) {
  184.         if ( (defined $userlinkage)
  185.         && !(@optionlist > 0 && ref($optionlist[0]))
  186.         && (exists $userlinkage->{$opt})
  187.         && ref($userlinkage->{$opt}) ) {
  188.         unshift (@optionlist, $userlinkage->{$opt});
  189.         }
  190.         unless ( @optionlist > 0 
  191.             && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
  192.         $error .= "Option spec <> requires a reference to a subroutine\n";
  193.         next;
  194.         }
  195.         $linkage{'<>'} = shift (@optionlist);
  196.         next;
  197.     }
  198.  
  199.     # Match option spec. Allow '?' as an alias.
  200.     if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) {
  201.         $error .= "Error in option spec: \"$opt\"\n";
  202.         next;
  203.     }
  204.     my ($o, $c, $a) = ($1, $5);
  205.     $c = '' unless defined $c;
  206.  
  207.     if ( ! defined $o ) {
  208.         # empty -> '-' option
  209.         $opctl{$o = ''} = $c;
  210.     }
  211.     else {
  212.         # Handle alias names
  213.         my @o =  split (/\|/, $o);
  214.         my $linko = $o = $o[0];
  215.         # Force an alias if the option name is not locase.
  216.         $a = $o unless $o eq lc($o);
  217.         $o = lc ($o)
  218.         if $ignorecase > 1 
  219.             || ($ignorecase
  220.             && ($bundling ? length($o) > 1  : 1));
  221.  
  222.         foreach ( @o ) {
  223.         if ( $bundling && length($_) == 1 ) {
  224.             $_ = lc ($_) if $ignorecase > 1;
  225.             if ( $c eq '!' ) {
  226.             $opctl{"no$_"} = $c;
  227.             warn ("Ignoring '!' modifier for short option $_\n");
  228.             $c = '';
  229.             }
  230.             $opctl{$_} = $bopctl{$_} = $c;
  231.         }
  232.         else {
  233.             $_ = lc ($_) if $ignorecase;
  234.             if ( $c eq '!' ) {
  235.             $opctl{"no$_"} = $c;
  236.             $c = '';
  237.             }
  238.             $opctl{$_} = $c;
  239.         }
  240.         if ( defined $a ) {
  241.             # Note alias.
  242.             $aliases{$_} = $a;
  243.         }
  244.         else {
  245.             # Set primary name.
  246.             $a = $_;
  247.         }
  248.         }
  249.         $o = $linko;
  250.     }
  251.  
  252.     # If no linkage is supplied in the @optionlist, copy it from
  253.     # the userlinkage if available.
  254.     if ( defined $userlinkage ) {
  255.         unless ( @optionlist > 0 && ref($optionlist[0]) ) {
  256.         if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
  257.             print STDERR ("=> found userlinkage for \"$o\": ",
  258.                   "$userlinkage->{$o}\n")
  259.             if $debug;
  260.             unshift (@optionlist, $userlinkage->{$o});
  261.         }
  262.         else {
  263.             # Do nothing. Being undefined will be handled later.
  264.             next;
  265.         }
  266.         }
  267.     }
  268.  
  269.     # Copy the linkage. If omitted, link to global variable.
  270.     if ( @optionlist > 0 && ref($optionlist[0]) ) {
  271.         print STDERR ("=> link \"$o\" to $optionlist[0]\n")
  272.         if $debug;
  273.         if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
  274.         $linkage{$o} = shift (@optionlist);
  275.         }
  276.         elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
  277.         $linkage{$o} = shift (@optionlist);
  278.         $opctl{$o} .= '@'
  279.           if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
  280.         $bopctl{$o} .= '@'
  281.           if $bundling and defined $bopctl{$o} and 
  282.             $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
  283.         }
  284.         elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
  285.         $linkage{$o} = shift (@optionlist);
  286.         $opctl{$o} .= '%'
  287.           if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
  288.         $bopctl{$o} .= '%'
  289.           if $bundling and defined $bopctl{$o} and 
  290.             $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
  291.         }
  292.         else {
  293.         $error .= "Invalid option linkage for \"$opt\"\n";
  294.         }
  295.     }
  296.     else {
  297.         # Link to global $opt_XXX variable.
  298.         # Make sure a valid perl identifier results.
  299.         my $ov = $o;
  300.         $ov =~ s/\W/_/g;
  301.         if ( $c =~ /@/ ) {
  302.         print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
  303.             if $debug;
  304.         eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
  305.         }
  306.         elsif ( $c =~ /%/ ) {
  307.         print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
  308.             if $debug;
  309.         eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
  310.         }
  311.         else {
  312.         print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
  313.             if $debug;
  314.         eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
  315.         }
  316.     }
  317.     }
  318.  
  319.     # Bail out if errors found.
  320.     die ($error) if $error;
  321.     $error = 0;
  322.  
  323.     # Sort the possible long option names.
  324.     @opctl = sort(keys (%opctl)) if $autoabbrev;
  325.  
  326.     # Show the options tables if debugging.
  327.     if ( $debug ) {
  328.     my ($arrow, $k, $v);
  329.     $arrow = "=> ";
  330.     while ( ($k,$v) = each(%opctl) ) {
  331.         print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
  332.         $arrow = "   ";
  333.     }
  334.     $arrow = "=> ";
  335.     while ( ($k,$v) = each(%bopctl) ) {
  336.         print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
  337.         $arrow = "   ";
  338.     }
  339.     }
  340.  
  341.     # Process argument list
  342.     while ( @ARGV > 0 ) {
  343.  
  344.     #### Get next argument ####
  345.  
  346.     $opt = shift (@ARGV);
  347.     print STDERR ("=> option \"", $opt, "\"\n") if $debug;
  348.  
  349.     #### Determine what we have ####
  350.  
  351.     # Double dash is option list terminator.
  352.     if ( $opt eq $argend ) {
  353.         # Finish. Push back accumulated arguments and return.
  354.         unshift (@ARGV, @ret) 
  355.         if $order == $PERMUTE;
  356.         return ($error == 0);
  357.     }
  358.  
  359.     my $tryopt = $opt;
  360.     my $found;        # success status
  361.     my $dsttype;        # destination type ('@' or '%')
  362.     my $incr;        # destination increment 
  363.     my $key;        # key (if hash type)
  364.     my $arg;        # option argument
  365.  
  366.     ($found, $opt, $arg, $dsttype, $incr, $key) = 
  367.       FindOption ($genprefix, $argend, $opt, 
  368.               \%opctl, \%bopctl, \@opctl, \%aliases);
  369.  
  370.     if ( $found ) {
  371.         
  372.         # FindOption undefines $opt in case of errors.
  373.         next unless defined $opt;
  374.  
  375.         if ( defined $arg ) {
  376.         $opt = $aliases{$opt} if defined $aliases{$opt};
  377.  
  378.         if ( defined $linkage{$opt} ) {
  379.             print STDERR ("=> ref(\$L{$opt}) -> ",
  380.                   ref($linkage{$opt}), "\n") if $debug;
  381.  
  382.             if ( ref($linkage{$opt}) eq 'SCALAR' ) {
  383.             if ( $incr ) {
  384.                 print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
  385.                   if $debug;
  386.                 if ( defined ${$linkage{$opt}} ) {
  387.                     ${$linkage{$opt}} += $arg;
  388.                 }
  389.                     else {
  390.                     ${$linkage{$opt}} = $arg;
  391.                 }
  392.             }
  393.             else {
  394.                 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
  395.                   if $debug;
  396.                 ${$linkage{$opt}} = $arg;
  397.                 }
  398.             }
  399.             elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
  400.             print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
  401.                 if $debug;
  402.             push (@{$linkage{$opt}}, $arg);
  403.             }
  404.             elsif ( ref($linkage{$opt}) eq 'HASH' ) {
  405.             print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
  406.                 if $debug;
  407.             $linkage{$opt}->{$key} = $arg;
  408.             }
  409.             elsif ( ref($linkage{$opt}) eq 'CODE' ) {
  410.             print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
  411.                 if $debug;
  412.             &{$linkage{$opt}}($opt, $arg);
  413.             }
  414.             else {
  415.             print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
  416.                       "\" in linkage\n");
  417.             Croak ("Getopt::Long -- internal error!\n");
  418.             }
  419.         }
  420.         # No entry in linkage means entry in userlinkage.
  421.         elsif ( $dsttype eq '@' ) {
  422.             if ( defined $userlinkage->{$opt} ) {
  423.             print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
  424.                 if $debug;
  425.             push (@{$userlinkage->{$opt}}, $arg);
  426.             }
  427.             else {
  428.             print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
  429.                 if $debug;
  430.             $userlinkage->{$opt} = [$arg];
  431.             }
  432.         }
  433.         elsif ( $dsttype eq '%' ) {
  434.             if ( defined $userlinkage->{$opt} ) {
  435.             print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
  436.                 if $debug;
  437.             $userlinkage->{$opt}->{$key} = $arg;
  438.             }
  439.             else {
  440.             print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
  441.                 if $debug;
  442.             $userlinkage->{$opt} = {$key => $arg};
  443.             }
  444.         }
  445.         else {
  446.             if ( $incr ) {
  447.             print STDERR ("=> \$L{$opt} += \"$arg\"\n")
  448.               if $debug;
  449.             if ( defined $userlinkage->{$opt} ) {
  450.                 $userlinkage->{$opt} += $arg;
  451.             }
  452.             else {
  453.                 $userlinkage->{$opt} = $arg;
  454.             }
  455.             }
  456.             else {
  457.             print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
  458.             $userlinkage->{$opt} = $arg;
  459.             }
  460.         }
  461.         }
  462.     }
  463.  
  464.     # Not an option. Save it if we $PERMUTE and don't have a <>.
  465.     elsif ( $order == $PERMUTE ) {
  466.         # Try non-options call-back.
  467.         my $cb;
  468.         if ( (defined ($cb = $linkage{'<>'})) ) {
  469.         &$cb ($tryopt);
  470.         }
  471.         else {
  472.         print STDERR ("=> saving \"$tryopt\" ",
  473.                   "(not an option, may permute)\n") if $debug;
  474.         push (@ret, $tryopt);
  475.         }
  476.         next;
  477.     }
  478.  
  479.     # ...otherwise, terminate.
  480.     else {
  481.         # Push this one back and exit.
  482.         unshift (@ARGV, $tryopt);
  483.         return ($error == 0);
  484.     }
  485.  
  486.     }
  487.  
  488.     # Finish.
  489.     if ( $order == $PERMUTE ) {
  490.     #  Push back accumulated arguments
  491.     print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
  492.         if $debug && @ret > 0;
  493.     unshift (@ARGV, @ret) if @ret > 0;
  494.     }
  495.  
  496.     return ($error == 0);
  497. }
  498.  
  499. # Option lookup.
  500. sub FindOption ($$$$$$$) {
  501.  
  502.     # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
  503.     # returns (0) otherwise.
  504.  
  505.     my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
  506.     my $key;            # hash key for a hash option
  507.     my $arg;
  508.  
  509.     print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
  510.  
  511.     return (0) unless $opt =~ /^$prefix(.*)$/s;
  512.  
  513.     $opt = $+;
  514.     my ($starter) = $1;
  515.  
  516.     print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
  517.  
  518.     my $optarg = undef;    # value supplied with --opt=value
  519.     my $rest = undef;    # remainder from unbundling
  520.  
  521.     # If it is a long option, it may include the value.
  522.     if (($starter eq "--" || ($getopt_compat && !$bundling))
  523.     && $opt =~ /^([^=]+)=(.*)$/s ) {
  524.     $opt = $1;
  525.     $optarg = $2;
  526.     print STDERR ("=> option \"", $opt, 
  527.               "\", optarg = \"$optarg\"\n") if $debug;
  528.     }
  529.  
  530.     #### Look it up ###
  531.  
  532.     my $tryopt = $opt;        # option to try
  533.     my $optbl = $opctl;        # table to look it up (long names)
  534.     my $type;
  535.     my $dsttype = '';
  536.     my $incr = 0;
  537.  
  538.     if ( $bundling && $starter eq '-' ) {
  539.     # Unbundle single letter option.
  540.     $rest = substr ($tryopt, 1);
  541.     $tryopt = substr ($tryopt, 0, 1);
  542.     $tryopt = lc ($tryopt) if $ignorecase > 1;
  543.     print STDERR ("=> $starter$tryopt unbundled from ",
  544.               "$starter$tryopt$rest\n") if $debug;
  545.     $rest = undef unless $rest ne '';
  546.     $optbl = $bopctl;    # look it up in the short names table
  547.  
  548.     # If bundling == 2, long options can override bundles.
  549.     if ( $bundling == 2 and
  550.          defined ($type = $opctl->{$tryopt.$rest}) ) {
  551.         print STDERR ("=> $starter$tryopt rebundled to ",
  552.               "$starter$tryopt$rest\n") if $debug;
  553.         $tryopt .= $rest;
  554.         undef $rest;
  555.     }
  556.     } 
  557.  
  558.     # Try auto-abbreviation.
  559.     elsif ( $autoabbrev ) {
  560.     # Downcase if allowed.
  561.     $tryopt = $opt = lc ($opt) if $ignorecase;
  562.     # Turn option name into pattern.
  563.     my $pat = quotemeta ($opt);
  564.     # Look up in option names.
  565.     my @hits = grep (/^$pat/, @{$names});
  566.     print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
  567.               "out of ", scalar(@{$names}), "\n") if $debug;
  568.  
  569.     # Check for ambiguous results.
  570.     unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
  571.         # See if all matches are for the same option.
  572.         my %hit;
  573.         foreach ( @hits ) {
  574.         $_ = $aliases->{$_} if defined $aliases->{$_};
  575.         $hit{$_} = 1;
  576.         }
  577.         # Now see if it really is ambiguous.
  578.         unless ( keys(%hit) == 1 ) {
  579.         return (0) if $passthrough;
  580.         warn ("Option ", $opt, " is ambiguous (",
  581.               join(", ", @hits), ")\n");
  582.         $error++;
  583.         undef $opt;
  584.         return (1, $opt,$arg,$dsttype,$incr,$key);
  585.         }
  586.         @hits = keys(%hit);
  587.     }
  588.  
  589.     # Complete the option name, if appropriate.
  590.     if ( @hits == 1 && $hits[0] ne $opt ) {
  591.         $tryopt = $hits[0];
  592.         $tryopt = lc ($tryopt) if $ignorecase;
  593.         print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
  594.         if $debug;
  595.     }
  596.     }
  597.  
  598.     # Map to all lowercase if ignoring case.
  599.     elsif ( $ignorecase ) {
  600.     $tryopt = lc ($opt);
  601.     }
  602.  
  603.     # Check validity by fetching the info.
  604.     $type = $optbl->{$tryopt} unless defined $type;
  605.     unless  ( defined $type ) {
  606.     return (0) if $passthrough;
  607.     warn ("Unknown option: ", $opt, "\n");
  608.     $error++;
  609.     return (1, $opt,$arg,$dsttype,$incr,$key);
  610.     }
  611.     # Apparently valid.
  612.     $opt = $tryopt;
  613.     print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
  614.  
  615.     #### Determine argument status ####
  616.  
  617.     # If it is an option w/o argument, we're almost finished with it.
  618.     if ( $type eq '' || $type eq '!' || $type eq '+' ) {
  619.     if ( defined $optarg ) {
  620.         return (0) if $passthrough;
  621.         warn ("Option ", $opt, " does not take an argument\n");
  622.         $error++;
  623.         undef $opt;
  624.     }
  625.     elsif ( $type eq '' || $type eq '+' ) {
  626.         $arg = 1;        # supply explicit value
  627.         $incr = $type eq '+';
  628.     }
  629.     else {
  630.         substr ($opt, 0, 2) = ''; # strip NO prefix
  631.         $arg = 0;        # supply explicit value
  632.     }
  633.     unshift (@ARGV, $starter.$rest) if defined $rest;
  634.     return (1, $opt,$arg,$dsttype,$incr,$key);
  635.     }
  636.  
  637.     # Get mandatory status and type info.
  638.     my $mand;
  639.     ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
  640.  
  641.     # Check if there is an option argument available.
  642.     if ( defined $optarg ? ($optarg eq '') 
  643.      : !(defined $rest || @ARGV > 0) ) {
  644.     # Complain if this option needs an argument.
  645.     if ( $mand eq "=" ) {
  646.         return (0) if $passthrough;
  647.         warn ("Option ", $opt, " requires an argument\n");
  648.         $error++;
  649.         undef $opt;
  650.     }
  651.     if ( $mand eq ":" ) {
  652.         $arg = $type eq "s" ? '' : 0;
  653.     }
  654.     return (1, $opt,$arg,$dsttype,$incr,$key);
  655.     }
  656.  
  657.     # Get (possibly optional) argument.
  658.     $arg = (defined $rest ? $rest
  659.         : (defined $optarg ? $optarg : shift (@ARGV)));
  660.  
  661.     # Get key if this is a "name=value" pair for a hash option.
  662.     $key = undef;
  663.     if ($dsttype eq '%' && defined $arg) {
  664.     ($key, $arg) = ($arg =~ /^(.*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
  665.     }
  666.  
  667.     #### Check if the argument is valid for this option ####
  668.  
  669.     if ( $type eq "s" ) {    # string
  670.     # A mandatory string takes anything. 
  671.     return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
  672.  
  673.     # An optional string takes almost anything. 
  674.     return (1, $opt,$arg,$dsttype,$incr,$key) 
  675.       if defined $optarg || defined $rest;
  676.     return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
  677.  
  678.     # Check for option or option list terminator.
  679.     if ($arg eq $argend ||
  680.         $arg =~ /^$prefix.+/) {
  681.         # Push back.
  682.         unshift (@ARGV, $arg);
  683.         # Supply empty value.
  684.         $arg = '';
  685.     }
  686.     }
  687.  
  688.     elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
  689.     if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/s ) {
  690.         $arg = $1;
  691.         $rest = $2;
  692.         unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
  693.     }
  694.     elsif ( $arg !~ /^-?[0-9]+$/ ) {
  695.         if ( defined $optarg || $mand eq "=" ) {
  696.         if ( $passthrough ) {
  697.             unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
  698.               unless defined $optarg;
  699.             return (0);
  700.         }
  701.         warn ("Value \"", $arg, "\" invalid for option ",
  702.               $opt, " (number expected)\n");
  703.         $error++;
  704.         undef $opt;
  705.         # Push back.
  706.         unshift (@ARGV, $starter.$rest) if defined $rest;
  707.         }
  708.         else {
  709.         # Push back.
  710.         unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
  711.         # Supply default value.
  712.         $arg = 0;
  713.         }
  714.     }
  715.     }
  716.  
  717.     elsif ( $type eq "f" ) { # real number, int is also ok
  718.     # We require at least one digit before a point or 'e',
  719.     # and at least one digit following the point and 'e'.
  720.     # [-]NN[.NN][eNN]
  721.     if ( $bundling && defined $rest &&
  722.          $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/s ) {
  723.         $arg = $1;
  724.         $rest = $+;
  725.         unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
  726.     }
  727.     elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) {
  728.         if ( defined $optarg || $mand eq "=" ) {
  729.         if ( $passthrough ) {
  730.             unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
  731.               unless defined $optarg;
  732.             return (0);
  733.         }
  734.         warn ("Value \"", $arg, "\" invalid for option ",
  735.               $opt, " (real number expected)\n");
  736.         $error++;
  737.         undef $opt;
  738.         # Push back.
  739.         unshift (@ARGV, $starter.$rest) if defined $rest;
  740.         }
  741.         else {
  742.         # Push back.
  743.         unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
  744.         # Supply default value.
  745.         $arg = 0.0;
  746.         }
  747.     }
  748.     }
  749.     else {
  750.     Croak ("GetOpt::Long internal error (Can't happen)\n");
  751.     }
  752.     return (1, $opt, $arg, $dsttype, $incr, $key);
  753. }
  754.  
  755. # Getopt::Long Configuration.
  756. sub Configure (@) {
  757.     my (@options) = @_;
  758.     my $opt;
  759.     foreach $opt ( @options ) {
  760.     my $try = lc ($opt);
  761.     my $action = 1;
  762.     if ( $try =~ /^no_?(.*)$/s ) {
  763.         $action = 0;
  764.         $try = $+;
  765.     }
  766.     if ( $try eq 'default' or $try eq 'defaults' ) {
  767.         ConfigDefaults () if $action;
  768.     }
  769.     elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
  770.         $autoabbrev = $action;
  771.     }
  772.     elsif ( $try eq 'getopt_compat' ) {
  773.         $getopt_compat = $action;
  774.     }
  775.     elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
  776.         $ignorecase = $action;
  777.     }
  778.     elsif ( $try eq 'ignore_case_always' ) {
  779.         $ignorecase = $action ? 2 : 0;
  780.     }
  781.     elsif ( $try eq 'bundling' ) {
  782.         $bundling = $action;
  783.     }
  784.     elsif ( $try eq 'bundling_override' ) {
  785.         $bundling = $action ? 2 : 0;
  786.     }
  787.     elsif ( $try eq 'require_order' ) {
  788.         $order = $action ? $REQUIRE_ORDER : $PERMUTE;
  789.     }
  790.     elsif ( $try eq 'permute' ) {
  791.         $order = $action ? $PERMUTE : $REQUIRE_ORDER;
  792.     }
  793.     elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
  794.         $passthrough = $action;
  795.     }
  796.     elsif ( $try =~ /^prefix=(.+)$/ ) {
  797.         $genprefix = $1;
  798.         # Turn into regexp. Needs to be parenthesized!
  799.         $genprefix = "(" . quotemeta($genprefix) . ")";
  800.         eval { '' =~ /$genprefix/; };
  801.         Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
  802.     }
  803.     elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
  804.         $genprefix = $1;
  805.         # Parenthesize if needed.
  806.         $genprefix = "(" . $genprefix . ")" 
  807.           unless $genprefix =~ /^\(.*\)$/;
  808.         eval { '' =~ /$genprefix/; };
  809.         Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
  810.     }
  811.     elsif ( $try eq 'debug' ) {
  812.         $debug = $action;
  813.     }
  814.     else {
  815.         Croak ("Getopt::Long: unknown config parameter \"$opt\"")
  816.     }
  817.     }
  818. }
  819.  
  820. # Deprecated name.
  821. sub config (@) {
  822.     Configure (@_);
  823. }
  824.  
  825. # To prevent Carp from being loaded unnecessarily.
  826. sub Croak (@) {
  827.     require 'Carp.pm';
  828.     $Carp::CarpLevel = 1;
  829.     Carp::croak(@_);
  830. };
  831.  
  832. ################ Documentation ################
  833.  
  834. =head1 NAME
  835.  
  836. GetOptions - extended processing of command line options
  837.  
  838. =head1 SYNOPSIS
  839.  
  840.   use Getopt::Long;
  841.   $result = GetOptions (...option-descriptions...);
  842.  
  843. =head1 DESCRIPTION
  844.  
  845. The Getopt::Long module implements an extended getopt function called
  846. GetOptions(). This function adheres to the POSIX syntax for command
  847. line options, with GNU extensions. In general, this means that options
  848. have long names instead of single letters, and are introduced with a
  849. double dash "--". Support for bundling of command line options, as was
  850. the case with the more traditional single-letter approach, is provided
  851. but not enabled by default. For example, the UNIX "ps" command can be
  852. given the command line "option"
  853.  
  854.   -vax
  855.  
  856. which means the combination of B<-v>, B<-a> and B<-x>. With the new
  857. syntax B<--vax> would be a single option, probably indicating a
  858. computer architecture. 
  859.  
  860. Command line options can be used to set values. These values can be
  861. specified in one of two ways:
  862.  
  863.   --size 24
  864.   --size=24
  865.  
  866. GetOptions is called with a list of option-descriptions, each of which
  867. consists of two elements: the option specifier and the option linkage.
  868. The option specifier defines the name of the option and, optionally,
  869. the value it can take. The option linkage is usually a reference to a
  870. variable that will be set when the option is used. For example, the
  871. following call to GetOptions:
  872.  
  873.   GetOptions("size=i" => \$offset);
  874.  
  875. will accept a command line option "size" that must have an integer
  876. value. With a command line of "--size 24" this will cause the variable
  877. $offset to get the value 24.
  878.  
  879. Alternatively, the first argument to GetOptions may be a reference to
  880. a HASH describing the linkage for the options, or an object whose
  881. class is based on a HASH. The following call is equivalent to the
  882. example above:
  883.  
  884.   %optctl = ("size" => \$offset);
  885.   GetOptions(\%optctl, "size=i");
  886.  
  887. Linkage may be specified using either of the above methods, or both.
  888. Linkage specified in the argument list takes precedence over the
  889. linkage specified in the HASH.
  890.  
  891. The command line options are taken from array @ARGV. Upon completion
  892. of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
  893. the command line.
  894.  
  895. Each option specifier designates the name of the option, optionally
  896. followed by an argument specifier.
  897.  
  898. Options that do not take arguments will have no argument specifier. 
  899. The option variable will be set to 1 if the option is used.
  900.  
  901. For the other options, the values for argument specifiers are:
  902.  
  903. =over 8
  904.  
  905. =item !
  906.  
  907. Option does not take an argument and may be negated, i.e. prefixed by
  908. "no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
  909. (with value 0).
  910. The option variable will be set to 1, or 0 if negated.
  911.  
  912. =item +
  913.  
  914. Option does not take an argument and will be incremented by 1 every
  915. time it appears on the command line. E.g. "more+", when used with
  916. B<--more --more --more>, will set the option variable to 3 (provided
  917. it was 0 or undefined at first).
  918.  
  919. The B<+> specifier is ignored if the option destination is not a SCALAR.
  920.  
  921. =item =s
  922.  
  923. Option takes a mandatory string argument.
  924. This string will be assigned to the option variable.
  925. Note that even if the string argument starts with B<-> or B<-->, it
  926. will not be considered an option on itself.
  927.  
  928. =item :s
  929.  
  930. Option takes an optional string argument.
  931. This string will be assigned to the option variable.
  932. If omitted, it will be assigned "" (an empty string).
  933. If the string argument starts with B<-> or B<-->, it
  934. will be considered an option on itself.
  935.  
  936. =item =i
  937.  
  938. Option takes a mandatory integer argument.
  939. This value will be assigned to the option variable.
  940. Note that the value may start with B<-> to indicate a negative
  941. value. 
  942.  
  943. =item :i
  944.  
  945. Option takes an optional integer argument.
  946. This value will be assigned to the option variable.
  947. If omitted, the value 0 will be assigned.
  948. Note that the value may start with B<-> to indicate a negative
  949. value.
  950.  
  951. =item =f
  952.  
  953. Option takes a mandatory real number argument.
  954. This value will be assigned to the option variable.
  955. Note that the value may start with B<-> to indicate a negative
  956. value.
  957.  
  958. =item :f
  959.  
  960. Option takes an optional real number argument.
  961. This value will be assigned to the option variable.
  962. If omitted, the value 0 will be assigned.
  963.  
  964. =back
  965.  
  966. A lone dash B<-> is considered an option, the corresponding option
  967. name is the empty string.
  968.  
  969. A double dash on itself B<--> signals end of the options list.
  970.  
  971. =head2 Linkage specification
  972.  
  973. The linkage specifier is optional. If no linkage is explicitly
  974. specified but a ref HASH is passed, GetOptions will place the value in
  975. the HASH. For example:
  976.  
  977.   %optctl = ();
  978.   GetOptions (\%optctl, "size=i");
  979.  
  980. will perform the equivalent of the assignment
  981.  
  982.   $optctl{"size"} = 24;
  983.  
  984. For array options, a reference to an array is used, e.g.:
  985.  
  986.   %optctl = ();
  987.   GetOptions (\%optctl, "sizes=i@");
  988.  
  989. with command line "-sizes 24 -sizes 48" will perform the equivalent of
  990. the assignment
  991.  
  992.   $optctl{"sizes"} = [24, 48];
  993.  
  994. For hash options (an option whose argument looks like "name=value"),
  995. a reference to a hash is used, e.g.:
  996.  
  997.   %optctl = ();
  998.   GetOptions (\%optctl, "define=s%");
  999.  
  1000. with command line "--define foo=hello --define bar=world" will perform the
  1001. equivalent of the assignment
  1002.  
  1003.   $optctl{"define"} = {foo=>'hello', bar=>'world')
  1004.  
  1005. If no linkage is explicitly specified and no ref HASH is passed,
  1006. GetOptions will put the value in a global variable named after the
  1007. option, prefixed by "opt_". To yield a usable Perl variable,
  1008. characters that are not part of the syntax for variables are
  1009. translated to underscores. For example, "--fpp-struct-return" will set
  1010. the variable $opt_fpp_struct_return. Note that this variable resides
  1011. in the namespace of the calling program, not necessarily B<main>.
  1012. For example:
  1013.  
  1014.   GetOptions ("size=i", "sizes=i@");
  1015.  
  1016. with command line "-size 10 -sizes 24 -sizes 48" will perform the
  1017. equivalent of the assignments
  1018.  
  1019.   $opt_size = 10;
  1020.   @opt_sizes = (24, 48);
  1021.  
  1022. A lone dash B<-> is considered an option, the corresponding Perl
  1023. identifier is $opt_ .
  1024.  
  1025. The linkage specifier can be a reference to a scalar, a reference to
  1026. an array, a reference to a hash or a reference to a subroutine.
  1027.  
  1028. Note that, if your code is running under the recommended C<use strict
  1029. 'vars'> pragma, it may be helpful to declare these package variables
  1030. via C<use vars> perhaps something like this:
  1031.  
  1032.   use vars qw/ $opt_size @opt_sizes $opt_bar /;
  1033.  
  1034. If a REF SCALAR is supplied, the new value is stored in the referenced
  1035. variable. If the option occurs more than once, the previous value is
  1036. overwritten. 
  1037.  
  1038. If a REF ARRAY is supplied, the new value is appended (pushed) to the
  1039. referenced array. 
  1040.  
  1041. If a REF HASH is supplied, the option value should look like "key" or
  1042. "key=value" (if the "=value" is omitted then a value of 1 is implied).
  1043. In this case, the element of the referenced hash with the key "key"
  1044. is assigned "value". 
  1045.  
  1046. If a REF CODE is supplied, the referenced subroutine is called with
  1047. two arguments: the option name and the option value.
  1048. The option name is always the true name, not an abbreviation or alias.
  1049.  
  1050. =head2 Aliases and abbreviations
  1051.  
  1052. The option name may actually be a list of option names, separated by
  1053. "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
  1054. of this option. If no linkage is specified, options "foo", "bar" and
  1055. "blech" all will set $opt_foo. For convenience, the single character
  1056. "?" is allowed as an alias, e.g. "help|?".
  1057.  
  1058. Option names may be abbreviated to uniqueness, depending on
  1059. configuration option B<auto_abbrev>.
  1060.  
  1061. =head2 Non-option call-back routine
  1062.  
  1063. A special option specifier, E<lt>E<gt>, can be used to designate a subroutine
  1064. to handle non-option arguments. GetOptions will immediately call this
  1065. subroutine for every non-option it encounters in the options list.
  1066. This subroutine gets the name of the non-option passed.
  1067. This feature requires configuration option B<permute>, see section
  1068. CONFIGURATION OPTIONS.
  1069.  
  1070. See also the examples.
  1071.  
  1072. =head2 Option starters
  1073.  
  1074. On the command line, options can start with B<-> (traditional), B<-->
  1075. (POSIX) and B<+> (GNU, now being phased out). The latter is not
  1076. allowed if the environment variable B<POSIXLY_CORRECT> has been
  1077. defined.
  1078.  
  1079. Options that start with "--" may have an argument appended, separated
  1080. with an "=", e.g. "--foo=bar".
  1081.  
  1082. =head2 Return values and Errors
  1083.  
  1084. Configuration errors and errors in the option definitions are
  1085. signalled using C<die()> and will terminate the calling
  1086. program unless the call to C<Getopt::Long::GetOptions()> was embedded
  1087. in C<eval { ... }> or C<die()> was trapped using C<$SIG{__DIE__}>.
  1088.  
  1089. A return value of 1 (true) indicates success.
  1090.  
  1091. A return status of 0 (false) indicates that the function detected one
  1092. or more errors during option parsing. These errors are signalled using
  1093. C<warn()> and can be trapped with C<$SIG{__WARN__}>.
  1094.  
  1095. Errors that can't happen are signalled using C<Carp::croak()>.
  1096.  
  1097. =head1 COMPATIBILITY
  1098.  
  1099. Getopt::Long::GetOptions() is the successor of
  1100. B<newgetopt.pl> that came with Perl 4. It is fully upward compatible.
  1101. In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
  1102. the module.
  1103.  
  1104. If an "@" sign is appended to the argument specifier, the option is
  1105. treated as an array. Value(s) are not set, but pushed into array
  1106. @opt_name. If explicit linkage is supplied, this must be a reference
  1107. to an ARRAY.
  1108.  
  1109. If an "%" sign is appended to the argument specifier, the option is
  1110. treated as a hash. Value(s) of the form "name=value" are set by
  1111. setting the element of the hash %opt_name with key "name" to "value"
  1112. (if the "=value" portion is omitted it defaults to 1). If explicit
  1113. linkage is supplied, this must be a reference to a HASH.
  1114.  
  1115. If configuration option B<getopt_compat> is set (see section
  1116. CONFIGURATION OPTIONS), options that start with "+" or "-" may also
  1117. include their arguments, e.g. "+foo=bar". This is for compatiblity
  1118. with older implementations of the GNU "getopt" routine.
  1119.  
  1120. If the first argument to GetOptions is a string consisting of only
  1121. non-alphanumeric characters, it is taken to specify the option starter
  1122. characters. Everything starting with one of these characters from the
  1123. starter will be considered an option. B<Using a starter argument is
  1124. strongly deprecated.>
  1125.  
  1126. For convenience, option specifiers may have a leading B<-> or B<-->,
  1127. so it is possible to write:
  1128.  
  1129.    GetOptions qw(-foo=s --bar=i --ar=s);
  1130.  
  1131. =head1 EXAMPLES
  1132.  
  1133. If the option specifier is "one:i" (i.e. takes an optional integer
  1134. argument), then the following situations are handled:
  1135.  
  1136.    -one -two        -> $opt_one = '', -two is next option
  1137.    -one -2        -> $opt_one = -2
  1138.  
  1139. Also, assume specifiers "foo=s" and "bar:s" :
  1140.  
  1141.    -bar -xxx        -> $opt_bar = '', '-xxx' is next option
  1142.    -foo -bar        -> $opt_foo = '-bar'
  1143.    -foo --        -> $opt_foo = '--'
  1144.  
  1145. In GNU or POSIX format, option names and values can be combined:
  1146.  
  1147.    +foo=blech        -> $opt_foo = 'blech'
  1148.    --bar=        -> $opt_bar = ''
  1149.    --bar=--        -> $opt_bar = '--'
  1150.  
  1151. Example of using variable references:
  1152.  
  1153.    $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
  1154.  
  1155. With command line options "-foo blech -bar 24 -ar xx -ar yy" 
  1156. this will result in:
  1157.  
  1158.    $foo = 'blech'
  1159.    $opt_bar = 24
  1160.    @ar = ('xx','yy')
  1161.  
  1162. Example of using the E<lt>E<gt> option specifier:
  1163.  
  1164.    @ARGV = qw(-foo 1 bar -foo 2 blech);
  1165.    GetOptions("foo=i", \$myfoo, "<>", \&mysub);
  1166.  
  1167. Results:
  1168.  
  1169.    mysub("bar") will be called (with $myfoo being 1)
  1170.    mysub("blech") will be called (with $myfoo being 2)
  1171.  
  1172. Compare this with:
  1173.  
  1174.    @ARGV = qw(-foo 1 bar -foo 2 blech);
  1175.    GetOptions("foo=i", \$myfoo);
  1176.  
  1177. This will leave the non-options in @ARGV:
  1178.  
  1179.    $myfoo -> 2
  1180.    @ARGV -> qw(bar blech)
  1181.  
  1182. =head1 CONFIGURATION OPTIONS
  1183.  
  1184. B<GetOptions> can be configured by calling subroutine
  1185. B<Getopt::Long::Configure>. This subroutine takes a list of quoted
  1186. strings, each specifying a configuration option to be set, e.g.
  1187. B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
  1188. B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
  1189. are possible.
  1190.  
  1191. Previous versions of Getopt::Long used variables for the purpose of
  1192. configuring. Although manipulating these variables still work, it
  1193. is strongly encouraged to use the new B<config> routine. Besides, it
  1194. is much easier.
  1195.  
  1196. The following options are available:
  1197.  
  1198. =over 12
  1199.  
  1200. =item default
  1201.  
  1202. This option causes all configuration options to be reset to their
  1203. default values.
  1204.  
  1205. =item auto_abbrev
  1206.  
  1207. Allow option names to be abbreviated to uniqueness.
  1208. Default is set unless environment variable
  1209. POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset.
  1210.  
  1211. =item getopt_compat   
  1212.  
  1213. Allow '+' to start options.
  1214. Default is set unless environment variable
  1215. POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
  1216.  
  1217. =item require_order
  1218.  
  1219. Whether non-options are allowed to be mixed with
  1220. options.
  1221. Default is set unless environment variable
  1222. POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
  1223.  
  1224. See also B<permute>, which is the opposite of B<require_order>.
  1225.  
  1226. =item permute
  1227.  
  1228. Whether non-options are allowed to be mixed with
  1229. options.
  1230. Default is set unless environment variable
  1231. POSIXLY_CORRECT has been set, in which case B<permute> is reset.
  1232. Note that B<permute> is the opposite of B<require_order>.
  1233.  
  1234. If B<permute> is set, this means that 
  1235.  
  1236.     -foo arg1 -bar arg2 arg3
  1237.  
  1238. is equivalent to
  1239.  
  1240.     -foo -bar arg1 arg2 arg3
  1241.  
  1242. If a non-option call-back routine is specified, @ARGV will always be
  1243. empty upon succesful return of GetOptions since all options have been
  1244. processed, except when B<--> is used:
  1245.  
  1246.     -foo arg1 -bar arg2 -- arg3
  1247.  
  1248. will call the call-back routine for arg1 and arg2, and terminate
  1249. leaving arg2 in @ARGV.
  1250.  
  1251. If B<require_order> is set, options processing
  1252. terminates when the first non-option is encountered.
  1253.  
  1254.     -foo arg1 -bar arg2 arg3
  1255.  
  1256. is equivalent to
  1257.  
  1258.     -foo -- arg1 -bar arg2 arg3
  1259.  
  1260. =item bundling (default: reset)
  1261.  
  1262. Setting this variable to a non-zero value will allow single-character
  1263. options to be bundled. To distinguish bundles from long option names,
  1264. long options must be introduced with B<--> and single-character
  1265. options (and bundles) with B<->. For example,
  1266.  
  1267.     ps -vax --vax
  1268.  
  1269. would be equivalent to
  1270.  
  1271.     ps -v -a -x --vax
  1272.  
  1273. provided "vax", "v", "a" and "x" have been defined to be valid
  1274. options. 
  1275.  
  1276. Bundled options can also include a value in the bundle; for strings
  1277. this value is the rest of the bundle, but integer and floating values
  1278. may be combined in the bundle, e.g.
  1279.  
  1280.     scale -h24w80
  1281.  
  1282. is equivalent to
  1283.  
  1284.     scale -h 24 -w 80
  1285.  
  1286. Note: resetting B<bundling> also resets B<bundling_override>.
  1287.  
  1288. =item bundling_override (default: reset)
  1289.  
  1290. If B<bundling_override> is set, bundling is enabled as with
  1291. B<bundling> but now long option names override option bundles. In the
  1292. above example, B<-vax> would be interpreted as the option "vax", not
  1293. the bundle "v", "a", "x".
  1294.  
  1295. Note: resetting B<bundling_override> also resets B<bundling>.
  1296.  
  1297. B<Note:> Using option bundling can easily lead to unexpected results,
  1298. especially when mixing long options and bundles. Caveat emptor.
  1299.  
  1300. =item ignore_case  (default: set)
  1301.  
  1302. If set, case is ignored when matching options.
  1303.  
  1304. Note: resetting B<ignore_case> also resets B<ignore_case_always>.
  1305.  
  1306. =item ignore_case_always (default: reset)
  1307.  
  1308. When bundling is in effect, case is ignored on single-character
  1309. options also. 
  1310.  
  1311. Note: resetting B<ignore_case_always> also resets B<ignore_case>.
  1312.  
  1313. =item pass_through (default: reset)
  1314.  
  1315. Unknown options are passed through in @ARGV instead of being flagged
  1316. as errors. This makes it possible to write wrapper scripts that
  1317. process only part of the user supplied options, and passes the
  1318. remaining options to some other program.
  1319.  
  1320. This can be very confusing, especially when B<permute> is also set.
  1321.  
  1322. =item prefix
  1323.  
  1324. The string that starts options. See also B<prefix_pattern>.
  1325.  
  1326. =item prefix_pattern
  1327.  
  1328. A Perl pattern that identifies the strings that introduce options.
  1329. Default is C<(--|-|\+)> unless environment variable
  1330. POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
  1331.  
  1332. =item debug (default: reset)
  1333.  
  1334. Enable copious debugging output.
  1335.  
  1336. =back
  1337.  
  1338. =head1 OTHER USEFUL VARIABLES
  1339.  
  1340. =over 12
  1341.  
  1342. =item $Getopt::Long::VERSION
  1343.  
  1344. The version number of this Getopt::Long implementation in the format
  1345. C<major>.C<minor>. This can be used to have Exporter check the
  1346. version, e.g.
  1347.  
  1348.     use Getopt::Long 3.00;
  1349.  
  1350. You can inspect $Getopt::Long::major_version and
  1351. $Getopt::Long::minor_version for the individual components.
  1352.  
  1353. =item $Getopt::Long::error
  1354.  
  1355. Internal error flag. May be incremented from a call-back routine to
  1356. cause options parsing to fail.
  1357.  
  1358. =back
  1359.  
  1360. =head1 AUTHOR
  1361.  
  1362. Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
  1363.  
  1364. =head1 COPYRIGHT AND DISCLAIMER
  1365.  
  1366. This program is Copyright 1990,1998 by Johan Vromans.
  1367. This program is free software; you can redistribute it and/or
  1368. modify it under the terms of the GNU General Public License
  1369. as published by the Free Software Foundation; either version 2
  1370. of the License, or (at your option) any later version.
  1371.  
  1372. This program is distributed in the hope that it will be useful,
  1373. but WITHOUT ANY WARRANTY; without even the implied warranty of
  1374. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  1375. GNU General Public License for more details.
  1376.  
  1377. If you do not have a copy of the GNU General Public License write to
  1378. the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
  1379. MA 02139, USA.
  1380.  
  1381. =cut
  1382.